perm filename FIX[AM,DBL]4 blob
sn#206271 filedate 1976-03-16 generic text, type T, neo UTF8
(FILECREATED "16-MAR-76 03:58:34" <LENAT>F1.;1 14085
changes to: BLOWUP-COMPOSE FIXVARS FIXEDCONS)
(LISPXPRINT (QUOTE F1COMS)
T T)
[RPAQQ F1COMS ((FNS * FIXFNS)
FIXFNS
(VARS * FIXVARS)
FIXVARS GLOBALVARS FIXEDCONS [COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
FIXEDCONS]
(P (MAPC FIXEDCONS (QUOTE NEW-CON]
(DEFINEQ
(BLOWUP-COMPOSE
[LAMBDA (BA1 BA2)
[INCRB GTEMP12 (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE APPLICATION)
(QUOTE OF)
GTEMP12
(CONS (QUOTE AND)
(NCONC1 [MAP2CAR (ANY1OFE (GETB GTEMP12 (QUOTE D-R)))
BA-LIST
(FUNCTION (LAMBDA (D B)
(LIST (QUOTE ISA)
B
(KWOTE D]
(LIST (QUOTE EQUAL)
(LASTELE (GARGS2 GTEMP12))
(NCONC (LIST (QUOTE APPLYB)
(KWOTE GTEMP12)
(Q ALGS))
(GARGS GTEMP12]
[INCRB GTEMP12 (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE APPLICATION)
(QUOTE OF)
GUP1
(APPEND (LIST (QUOTE APPLYB)
(Q COMPOSE)
(Q ALGS)
(KWOTE BA1)
(KWOTE BA2))
(FIRSTN (LENGTH (CAAR GTEMP11))
BA-LIST]
(COND
([SETQ GTEMP308 (CAR (SOME (ACEX COMPOSE)
(FUNCTION (LAMBDA (C) (* The call on Lastele is because
Compose is an active, so its final
results are the last elements of each of
its examples)
(MEMBER (LASTELE (GETB GTEMP12 (QUOTE DEFN)))
(GETB (LASTELE C)
(QUOTE DEFN]
(KILB GTEMP12)
(CPRIN1S 8 GTEMP12 turned out to be equivalent to GTEMP308 DCR)
GTEMP308)
(T (INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
GTEMP12))
[SOME (RIPPLE GUP1 (QUOTE GENL))
(FUNCTION (LAMBDA (G)
(SOME (GETB G (QUOTE D-R))
(FUNCTION (LAMBDA (D)
(AND (ISA BA1 (CAR D))
(ISA BA2 (CADR D))
(INCRB GTEMP12 (QUOTE UP)
(CADDR D))
(INCRB (CADDR D)
(QUOTE EXS)
GTEMP12]
(* This last INCRB says that if an operation f maps onto range C, and we apply f and get a new
Being, then that Being ISA C)
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
(INCRB BA2 (QUOTE IN-DOM-OF)
GUP1)
(INCRB BA1 (QUOTE IN-DOM-OF)
GUP1)
[MAPC [ATOM-INT (DSET-DIFF [APPEND (OR (GETB BA1 (QUOTE GUP))
(GETB BA1 (QUOTE UP)))
(OR (GETB BA2 (QUOTE GUP))
(GETB BA2 (QUOTE UP]
(GETB GTEMP12 (QUOTE UP]
(FUNCTION (LAMBDA (Z)
(COND
((APPLY* (QUOTE DEFN)
Z GTEMP12)
(INCRB Z (QUOTE EXS)
GTEMP12)
(INCRB GTEMP12 (QUOTE UP)
Z] (* We should really repeat this later
on, since many defns involve searchig
for ALGS parts, ...)
(COND
[(GETB GTEMP12 (QUOTE UP))
(SETB GTEMP12 (QUOTE GUP)
(COPY (GETB GTEMP12 (QUOTE UP]
(T (INCRB GTEMP12 (QUOTE UP)
(QUOTE OPERATION))
(INCRB (QUOTE OPERATION)
(QUOTE EXS)
GTEMP12)))
[MAPC GTEMP200 (FUNCTION (LAMBDA (E)
[COND
((AND (NEQ (CADDR E)
GTEMP12)
(ISAG (CAR E)
BA1)
(ISAG (CADR E)
BA2))
(INCRB (CADDR E)
(QUOTE GENL)
GTEMP12)
(INCRB GTEMP12 (QUOTE SPEC)
(CADDR E]
(COND
((AND (NEQ (CADDR E)
GTEMP12)
(ISAS (CAR E)
BA1)
(ISAS (CADR E)
BA2))
(INCRB (CADDR E)
(QUOTE SPEC)
GTEMP12)
(INCRB GTEMP12 (QUOTE GENL)
(CADDR E]
(SETB GTEMP12 (QUOTE D-R)
(CAR GTEMP11))
(INCRB GTEMP12 (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(QUOTE APPLICATION)
(QUOTE OF)
GUP1
(CADR GTEMP11)))
(SETB GTEMP12 (QUOTE WORTH)
(MAP2CAR (GETB BA1 (QUOTE WORTH))
(GETB BA2 (QUOTE WORTH))
(QUOTE TIMES1000)))
GTEMP12])
(ABC5
[LAMBDA (V N X J Z) (* Instead of just ANYB-EXS.CHECK2,
maybe this should really be placed in
ANYB-ANYP.CHECK2)
(SETQ X (GETB CS-B (QUOTE EXS)))
[SETQ V (LARGER 1 (DOTPROD (GETB CS-B (QUOTE WORTH))
(LIST .05 .04 .01] (* V is the number of exs that CS-B is
permitted)
(SETQ N (SMALLER (IDIFFERENCE (LARGER (LENGTH X)
(IQUOTIENT (COUNT X)
50))
V)
(IDIFFERENCE (LENGTH X)
3)))
(COND
((MINUSP N) (* All is well)
T)
((ZEROP N)
(CPRIN1S 9 CRLF CS-B has as many examples as a concept that interesting should have DCR))
(T (* Must remove N examples)
(CPRIN1S 7 CRLF CS-B has (LENGTH X)
examples which occupy (COUNT X)
list cells COMMA but is not interesting enough
to warrant taking up that much space SEMICOLON so about N will be selected at random and forgotten DCR)
(FOR J FROM 1 TO N DO (DREMOVE (PROGN (SETQ Z (RAND-MEMB X))
(CPRIN1S 10 TAB Z CRLF)
Z)
X))
(SETQ GNEKNT (IPLUS GNEKNT N])
(NUM-WTS
[LAMBDA NIL
(SETB (QUOTE REV-ORD-PAIR)
(QUOTE WORTH)
(LIST 10))
(SETB (QUOTE CANONIZE)
(QUOTE WORTH)
(LIST 10))
(SETB (QUOTE INV-OP)
(QUOTE WORTH)
(LIST 50))
(SETB (QUOTE CONJEC)
(QUOTE WORTH)
(LIST 10))
(SETB (QUOTE MAP-JOIN)
(QUOTE WORTH)
(LIST 10))
(SETB (QUOTE MAP-REPLACE)
(QUOTE WORTH)
(LIST 10))
(SETB (QUOTE MAP-REPLACE2)
(QUOTE WORTH)
(LIST 10))
(SETB (QUOTE EMPTY-STRUC)
(QUOTE WORTH)
(LIST 100))
(SETB (QUOTE NON-EMPTY-STRUC)
(QUOTE WORTH)
(LIST 100))
(SETB (QUOTE ORD-PAIR)
(QUOTE WORTH)
(LIST 100))
[MAPC CONCEPTS (FUNCTION (LAMBDA (B)
(AND (CADDDR (GETB B (QUOTE WORTH)))
(SET-NTH (GETB B (QUOTE WORTH))
4 50]
(SETB (QUOTE COALESCE)
(QUOTE WORTH)
(LIST 200 200 100 50))
(SETB (QUOTE COMPOSE)
(QUOTE WORTH)
(LIST 200 200 100 50))
(SETB (QUOTE IDENTITY)
(QUOTE WORTH)
(LIST 100 100 900 10])
(ABT1
[LAMBDA (TK BT TK2 CX CSP L2)
(SETQ CX (ACX1 CS-B))
(SETQ CSP (FRIPPLE-S CS-B))
(SETQ BT (SORT (SET-DIFF (COND
((ISA CS-B (QUOTE PREDICATE))
(ACEX PREDICATE))
[(ISA CS-B (QUOTE ACTIVE))
[SETQ L2 (LENGTH (CAR (GETB CS-B (QUOTE D-R]
(SUBSET (ACEX ACTIVE)
(FUNCTION (LAMBDA (F)
(EQ L2 (LENGTH (CAR (GETB F (QUOTE D-R]
(T (SPEC OBJECT)))
(FRIPPLE-G CS-B))
(QUOTE MORE-INT)))
[SETQ TK2 (IPLUS (CLOCK 2)
(RMUL CS-INT GCONJ-FAC (ADD1 (LENGTH BT]
(SETQ TK (IPLUS (CLOCK 2)
(ITIMES CS-INT GCONJ-FAC)))
(PROG (B V BX)
L1 (COND
((NULL BT)
(RETURN V)))
(SETQ B (CAR BT))
(SETQ BT (CDR BT))
[COND
([EVERY CX (FUNCTION (LAMBDA (X)
(SAFE-DEFN B X NIL NIL NIL TK2]
(DSET-DIFF BT (FRIPPLE-G B))
(COND
((ISAG CS-B B)
(CPRIN1S 5 CS-B appears to be the same as B DCR)
(MERGE2BS (IS-CON B)
(IS-CON CS-B))
(SETQ V (CONS (SPLIST CS-B is the same as B COMMA and from now on we will call all (IS-CON CS-B)
APOS
as (IS-CON B)
APOS DCR)
V)))
(T (CPRIN1S 7 CS-B apparently is a specialization of B DCR)
(INCRB B (QUOTE SPEC)
CS-B)
(INCRB CS-B (QUOTE GENL)
B)
[INCRB CS-B (QUOTE TIES)
(LIST B (LIST (QUOTE EXS)
(QUOTE INCLUSION]
[INCRB B (QUOTE TIES)
(LIST CS-B (LIST (QUOTE EXS)
(QUOTE CONTAINMENT]
(SETQ V (CONS (SPLIST CS-B is a specialization of B)
V]
[COND
([AND (NOT (FMEMB B CSP))
(SETQ BX (ACXE B))
(EVERY BX (FUNCTION (LAMBDA (X)
(SAFE-DEFN CS-B X NIL NIL NIL TK2]
(DSET-DIFF BT (FRIPPLE-S B))
(COND
((ISAS CS-B B)
(CPRIN1S 5 CS-B appears to be the same as B DCR)
(MERGE2BS (IS-CON B)
(IS-CON CS-B))
(SETQ V (CONS (SPLIST CS-B is the same as B COMMA and from now on we will call all (IS-CON CS-B)
APOS
as (IS-CON B)
APOS DCR)
V)))
(T (CPRIN1S 7 CS-B apparently is a generalization of B DCR)
(INCRB CS-B (QUOTE SPEC)
B)
(INCRB B (QUOTE GENL)
CS-B)
[INCRB B (QUOTE TIES)
(LIST CS-B (LIST (QUOTE EXS)
(QUOTE INCLUSION]
[INCRB CS-B (QUOTE TIES)
(LIST B (LIST (QUOTE EXS)
(QUOTE CONTAINMENT]
(SETQ V (CONS (SPLIST CS-B is a generalization of B)
V]
(COND
((ILESSP (CLOCK 2)
TK)
(GO L1))
(T (RETURN V])
(AC-TIES1
[LAMBDA (RAN BI X1 BT TK2 POSEX CONX CXB EXLST)
(COND
((ISAG [SETQ RAN (LASTELE (ANY1OFE (GETB CS-B (QUOTE D-R]
(QUOTE STRUC-OF-STRUCS))
[SETQ BI (CDR (LASTELE (SETQ X1 (CAR (SOME (ACXE CS-B)
(FUNCTION (LAMBDA (X)
(NOT (FMEMB (CAR X)
(SETQ CXB (GETXB (CAR (ANY1OFE (GETB CS-B
(QUOTE D-R]
(SETQ BT (SET-DIFF (ATOM-INT (SPEC OBJECT))
(FRIPPLE-G RAN)))
[SETQ TK2 (IPLUS (CLOCK 2)
(RMUL CS-INT GCONJ-FAC (ADD1 (LENGTH BT]
[SETQ POSEX (SUBSET BT (FUNCTION (LAMBDA (X)
(SOME BI (FUNCTION (LAMBDA (BIJ)
(SAFE-DEFN X BIJ NIL NIL NIL TK2]
(CPRIN1S 6 Based
on the example X1
of CS-B COMMA AM will consider the following hypotheses: For each argument x COMMA CS-B returns a group
of structures
as its value COMMA and at least one of these structures is of type Y COMMA
where Y is potentially one of these: POSEX DCR)
[SETQ CONX (SUBSET POSEX (FUNCTION (LAMBDA (F)
(EVERY (ACXE CS-B)
(FUNCTION (LAMBDA (XI)
(OR [SOME (CDR (LASTELE XI))
(FUNCTION (LAMBDA (XIJ)
(SAFE-DEFN F XIJ NIL NIL NIL TK2]
(PROG1 NIL (SETQ EXLST (CONS F EXLST)))
(FMEMB (CAR XI)
CXB]
(CPRIN1S 6 Of these COMMA the following were confirmed for all examples COLON CONX DCR)
[MAPC (APPEND CONX)
(FUNCTION (LAMBDA (C)
(SETQ CONX (DSET-DIFF CONX (CDR (FRIPPLE-G C]
(CPRIN1S 6 After eliminating Generalizations of these concepts COMMA the following remain COLON CONX DCR)
(COND
((SETQ EXLST (INTERSECTION EXLST (APPEND CONX)))
(CPRIN1S 7 The following must be examined more carefully COMMA since they fail
for some boundary cases -- i.e., some members of CXB -- COLON EXLST DCR)))
(MAPCAR CONX (FUNCTION (LAMBDA (F)
(SPLIST The value of CS-B will always contain one or more element which is a F])
(EACH-ISA
[LAMBDA (S B)
(AND (APPLYB (QUOTE BAG-STRUC)
(QUOTE DEFN)
S)
(EVERY (CDR S)
(FUNCTION (LAMBDA (Z)
(APPLYB B (QUOTE DEFN)
Z])
)
(RPAQQ FIXFNS (BLOWUP-COMPOSE ABC5 NUM-WTS ABT1 AC-TIES1 EACH-ISA))
(RPAQQ GCONJ-FAC 90)
(RPAQQ FIXVARS (GCONJ-FAC))
(RPAQQ GLOBALVARS
(ACEXPIRE ALLOP AM AM-WAIT AM-WSECS APOS ARGS AUX-FACETS B-DEF BA-LIST BA-LIST2 BAL1 BAL2 CAND CAND-TAIL CANDS
CBEGIN CFN6COMS CIRC COLON COMMA CON6COMS CONCEPTS CONSTRUCTIVE-OPS CP9 CRLF CROS CS-ACT CS-B
CS-FAIL CS-INT CS-OP CS-P CS-WHY CTSPAN CVAL DASH DCR DEFN-STAK DISMISS DO-THRESH DOT DR-CHKLST
DR2CHKLST DUNNO ECMS EKNT ESTAT ETIM EX-THRESH EXCLAIM F-COUNTER FACETS FALSE FIRSTNAME FIXEDCONS
FIXFNS FIXVARS FL1 FL2 FL3 FL4 FROB FROB1 FV1 FV2 FV3 G-IF GADVISER GATH-PART GCAN-DEFN GCEKNT GCNT
GCONJ-FAC GD-TEST GEKNT GENG GEXISTING GIFN GINT-CONS GLEN GLOC-NOT GMSG GNEKNT GNUMS GPGM GPNAME
GQEKNT GRCOMP GREM GRPART GSOME-ELE GSOME-VAL GSP1 GSPEC-SUG GSPEC2SUG GSTL GSTRUC GSWI GTEKNT GTEMP
GTEMP1 GTEMP10 GTEMP101 GTEMP102 GTEMP103 GTEMP11 GTEMP117 GTEMP118 GTEMP119 GTEMP12 GTEMP120
GTEMP125 GTEMP126 GTEMP127 GTEMP128 GTEMP129 GTEMP13 GTEMP130 GTEMP131 GTEMP132 GTEMP133 GTEMP134
GTEMP135 GTEMP137 GTEMP138 GTEMP139 GTEMP14 GTEMP140 GTEMP15 GTEMP16 GTEMP17 GTEMP18 GTEMP19
GTEMP197 GTEMP198 GTEMP199 GTEMP2 GTEMP20 GTEMP200 GTEMP201 GTEMP21 GTEMP210 GTEMP212 GTEMP213
GTEMP214 GTEMP215 GTEMP216 GTEMP217 GTEMP218 GTEMP219 GTEMP22 GTEMP220 GTEMP221 GTEMP222 GTEMP223
GTEMP224 GTEMP225 GTEMP23 GTEMP24 GTEMP25 GTEMP26 GTEMP27 GTEMP28 GTEMP29 GTEMP3 GTEMP30 GTEMP301
GTEMP302 GTEMP307 GTEMP308 GTEMP309 GTEMP31 GTEMP310 GTEMP311 GTEMP312 GTEMP313 GTEMP314 GTEMP315
GTEMP316 GTEMP317 GTEMP318 GTEMP319 GTEMP330 GTEMP331 GTEMP332 GTEMP346 GTEMP351 GTEMP352 GTEMP36
GTEMP37 GTEMP370 GTEMP371 GTEMP372 GTEMP373 GTEMP380 GTEMP386 GTEMP39 GTEMP390 GTEMP391 GTEMP4
GTEMP43 GTEMP44 GTEMP46 GTEMP47 GTEMP48 GTEMP49 GTEMP5 GTEMP50 GTEMP51 GTEMP52 GTEMP53 GTEMP54
GTEMP55 GTEMP6 GTEMP60 GTEMP7 GTEMP8 GTEMP9 GTEMPA GTEMPP GUP1 GUSED GWHY GXTR-PART HCON HUND ILEV
INIT-CANDS INIT-DOTHRESH INIT-EXTHRESH INIT-INT-THRESH INIT-INTHRESH INIT-KILS INIT-ONCE-LIST
INIT-PAST GINTPREDS INT-THRESH INTHRESH JTRASH KILS LASTNAME LEXL LNK-PARTS LOOP-FNS LPAREN MAIN-D-R
MAXNAME MERGE-PARTS MWHY NCONCEPTS NEKNT NEW-C-PARTS NEW-CANDS NEW-CONCEPTS NEW-ILEV NEW-PARTS NEWB
NO-LIST NOSWAP-CONCEPTS NOSWAPF OBJX OK ONCE-LIST OR-PARTS ORIG-EMP PAST PHIST PKNT PLUS PMAC
POSS-RPARTS PREC PRIVBS PUNC PUNC1 PUNC2 QUES RANC RANDSTATE RANF RANU RB1 REASON REPR-FNS RPAREN
RTEM2 SEENCANDS SEMICOLON SIN5 SPACE STICKY-B STICKY-P STRAT STRATEGY-PARTS SUF-PARTS SUF1 SUF2
SWORDS SWSUF SYN-LIST SYNTH-RANGE SYS-FORGET-LIST TAB TKNT-INIT TMP1 TMP11 TMP2 TMP3 TMP4 TMP5 TMP6
TMP7 TMP8 TMP9 TOP-ACTS TOP6COMS TRIV-B TRIV-BVAL TRIVB TRUE TYRO UCONTROL USED USERNAME USERNAMES
UTIL6COMS V-REASON V1REASON VCONCEPTS VERBOSITY VERSION XEQ-PARTS XS-PARTS YES-LIST ZZBP SPARECOMS
SPARE-FNS))
(RPAQQ FIXEDCONS NIL)
(MAPC FIXEDCONS (QUOTE NEW-CON))
(DECLARE: DONTCOPY
(FILEMAP (NIL (380 11009 (BLOWUP-COMPOSE 392 . 3997) (ABC5 4001 . 5305) (NUM-WTS 5309 . 6319) (ABT1 6323 . 8894) (
AC-TIES1 8898 . 10831) (EACH-ISA 10835 . 11006)))))
STOP